home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / BPC-DE10.ZIP / FOSSIL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-09-05  |  4.2 KB  |  196 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 7.0                        }
  5. {       FOSSIL Support Unit                             }
  6. {                                                       }
  7. {       Copyright (c) 1994,95 by Solar Designer         }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit Fossil;
  12. {$G+}
  13. interface
  14.    uses
  15.       Objects;
  16.  
  17.    type
  18.       TBaudRate=
  19.       (br19200, br38400, br300, br600, br1200, br2400, br4800, br9600);
  20.       TWordLen=    5..8;
  21.       TStopBits=   1..2;
  22.       TParity=     (pcNone, pcOdd, pcEven);
  23.  
  24.       PFossilPort= ^TFossilPort;
  25.       TFossilPort=
  26.       object(TObject)
  27.  
  28.          PortNum             :Word;
  29.          Initialized         :Boolean;
  30.  
  31.          constructor Init(APortNum               :Word);
  32.  
  33.          destructor  Done; virtual;
  34.  
  35.          procedure SetParams(Rate                :TBaudRate;
  36.                              WordLen             :TWordLen;
  37.                              StopBits            :TStopBits;
  38.                              Parity              :TParity);
  39.  
  40.          procedure SendChar(c                    :Char);
  41.  
  42.          function  ReceiveChar                   :Char;
  43.  
  44.          function  PreviewChar                   :Char;
  45.  
  46.          function  GetStatus                     :Word;
  47.  
  48.          function  CharAvail                     :Boolean;
  49.  
  50.          function  CarrierDetect                 :Boolean;
  51.  
  52.          procedure SendString(const s            :String);
  53.  
  54.          procedure SendCommand(const Cmd         :String);
  55.  
  56.       end;
  57.  
  58. implementation
  59.  
  60.    constructor TFossilPort.Init;
  61.    begin
  62.       Inherited Init;
  63.       asm
  64.          les  di,Self
  65.          mov  dx,APortNum
  66.          mov  es:[di].PortNum,dx
  67.          xor  bx,bx
  68.          mov  ah,04h
  69.          int  14h
  70.          cmp  ax,1954h
  71.          jne  @@1
  72.          mov  es:[di].Initialized,1
  73. @@1:
  74.       end;
  75.    end;
  76.  
  77.    destructor  TFossilPort.Done;
  78.    var
  79.       Timer        :Word absolute 0:$46C;
  80.       LTimer       :Word;
  81.    begin
  82.       LTimer:=Timer;
  83.       while CarrierDetect and (Timer>=LTimer) and (Timer-LTimer<4) do;
  84.  
  85.       asm
  86.          les  di,Self
  87.          mov  dx,es:[di].PortNum
  88.          mov  ah,05h
  89.          int  14h
  90.          mov  es:[di].Initialized,0
  91.       end;
  92.       Inherited Done;
  93.    end;
  94.  
  95.    procedure TFossilPort.SetParams;
  96.    assembler;
  97.    asm
  98.       mov  al,Rate
  99.       shl  al,5
  100.       mov  cl,Parity
  101.       cmp  cl,2
  102.       jne  @@1
  103.       inc  cx
  104. @@1:
  105.       shl  cl,3
  106.       mov  bl,StopBits
  107.       dec  bx
  108.       shl  bl,2
  109.       mov  dl,WordLen
  110.       sub  dl,5
  111.  
  112.       or   al,cl
  113.       or   al,bl
  114.       or   al,dl
  115.  
  116.       les  di,Self
  117.       mov  dx,es:[di].PortNum
  118.       xor  ax,ax
  119.       int  14h
  120.    end;
  121.  
  122.    procedure TFossilPort.SendChar;
  123.    assembler;
  124.    asm
  125.       les  di,Self
  126.       mov  dx,es:[di].PortNum
  127.       mov  al,c
  128.       mov  ah,01h
  129.       int  14h
  130.    end;
  131.  
  132.    function  TFossilPort.ReceiveChar;
  133.    assembler;
  134.    asm
  135.       les  di,Self
  136.       mov  dx,es:[di].PortNum
  137.       mov  ah,02h
  138.       int  14h
  139.    end;
  140.  
  141.    function  TFossilPort.PreviewChar;
  142.    assembler;
  143.    asm
  144.       les  di,Self
  145.       mov  dx,es:[di].PortNum
  146.       mov  ah,0Ch
  147.       int  14h
  148.    end;
  149.  
  150.    function  TFossilPort.GetStatus;
  151.    assembler;
  152.    asm
  153.       les  di,Self
  154.       mov  dx,es:[di].PortNum
  155.       mov  ah,03h
  156.       int  14h
  157.    end;
  158.  
  159.    function  TFossilPort.CharAvail;
  160.    assembler;
  161.    asm
  162.       les  di,Self
  163.       push es
  164.       push di
  165.       call GetStatus
  166.       xchg al,ah
  167.       and  al,1
  168.    end;
  169.  
  170.    function  TFossilPort.CarrierDetect;
  171.    assembler;
  172.    asm
  173.       les  di,Self
  174.       push es
  175.       push di
  176.       call GetStatus
  177.       and  al,80h
  178.    end;
  179.  
  180.    procedure TFossilPort.SendString;
  181.    var
  182.       i            :Integer;
  183.    begin
  184.       for i:=1 to Length(s) do SendChar(s[i]);
  185.    end;
  186.  
  187.    procedure TFossilPort.SendCommand;
  188.    var
  189.       i            :Integer;
  190.    begin
  191.       for i:=1 to Length(Cmd) do
  192.       if Cmd[i]='|' then SendChar(#13) else SendChar(Cmd[i]);
  193.    end;
  194.  
  195. end.
  196.